Příprava

Načtení balíčků

library(tibble)
library(dplyr)
library(tidyr)
library(GA)
library(pso)
# --
library(plotly)
library(purrr)

Definování funkce, která bude optimalizována.

# 0 < x < 5
# 0 < y < 5
f <- function(params) {
  x <- params[1]
  y <- params[2]

  (x - 3.14)^2 + (y - 2.72)^2 + sin(3 * x + 1.41) + sin(4 * y - 1.73)
}

Grafické zobrazení funkce.

mult   <- 0.1
f_grid <- expand_grid(
  x = seq(mult, 5 - mult, by = mult),
  y = seq(mult, 5 - mult, by = mult)) |>
  mutate(z = map2_dbl(
    .x = x, .y = y,
    .f = ~ f(c(.x, .y))
  ))

plot_ly(f_grid,
        x = ~ x,
        y = ~ y,
        z = ~ z) |>
  add_mesh()

Z grafu lze vidět, že minimum je v bodě \(\sim (3.2, 3.1)\).

Gradient optimalizace

Startovací pozice \(0, 0\).

# Minimizes by default
set.seed(123)
gradients_00 <- optim(
  par = c(0, 0),
  fn = f,
  lower = c(0, 0),
  upper = c(5, 5),
  method = "L-BFGS-B"
)

gradients_00
## $par
## [1] 3.185155 1.738793
## 
## $value
## [1] -0.9061231
## 
## $counts
## function gradient 
##       12       12 
## 
## $convergence
## [1] 0
## 
## $message
## [1] "CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH"

Startovací pozice \(0, 0\) s upraveným krokem.

# Minimizes by default
set.seed(123)
gradients_00_step <- optim(
  par = c(0, 0),
  fn = f,
  lower = c(0, 0),
  upper = c(5, 5),
  method = "L-BFGS-B",
  control = list(
    ndeps = c(1e-6, 2)
  )
)

gradients_00_step
## $par
## [1] 3.186656 2.939276
## 
## $value
## [1] -1.515974
## 
## $counts
## function gradient 
##       31       31 
## 
## $convergence
## [1] 0
## 
## $message
## [1] "CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH"

Startovací pozice \(2.5, 2.5\).

# Minimizes by default
set.seed(123)
gradients_25 <- optim(
  par = c(2.5, 2.5),
  fn = f,
  lower = c(0, 0),
  upper = c(5, 5),
  method = "L-BFGS-B"
)

gradients_25
## $par
## [1] 3.185155 3.129803
## 
## $value
## [1] -1.808352
## 
## $counts
## function gradient 
##        9        9 
## 
## $convergence
## [1] 0
## 
## $message
## [1] "CONVERGENCE: REL_REDUCTION_OF_F <= FACTR*EPSMCH"

Evoluční algoritmus

# Maximizes by default
gares <- ga("real-valued",
  fitness = \(params) f(params) * -1,
  optim = T,
  lower = c(0, 0),
  upper = c(5, 5),
  run = 100,
  seed = 123
)

summary(gares)
## ── Genetic Algorithm ─────────────────── 
## 
## GA settings: 
## Type                  =  real-valued 
## Population size       =  50 
## Number of generations =  100 
## Elitism               =  2 
## Crossover probability =  0.8 
## Mutation probability  =  0.1 
## Search domain = 
##       x1 x2
## lower  0  0
## upper  5  5
## 
## GA results: 
## Iterations             = 100 
## Fitness function value = 1.808352 
## Solution = 
##            x1       x2
## [1,] 3.185155 3.129803
plot(gares)

algoritmus PSO

# Minimizes by default
set.seed(123)
pso <- psoptim(
  par = c(0, 0),
  fn = f,
  lower = c(0, 0),
  upper = c(5, 5)
)

pso
## $par
## [1] 3.185155 3.129803
## 
## $value
## [1] -1.808352
## 
## $counts
##  function iteration  restarts 
##     12000      1000         0 
## 
## $convergence
## [1] 2
## 
## $message
## [1] "Maximal number of iterations reached"

Porovnání

tribble(
  ~type,                      ~x,                        ~y,                       ~fit,
  "Gradient (0, 0)",          gradients_00$par[1],       gradients_00$par[2],      gradients_00$value,
  "Gradient (0, 0) s krokem", gradients_00_step$par[1],  gradients_00_step$par[2], gradients_00_step$value,
  "Gradient (2.5, 2.5)",      gradients_25$par[1],       gradients_25$par[2],      gradients_25$value,
  "Evoluční algoritmus",      gares@solution[1, 1],      gares@solution[1, 2],     gares@fitnessValue,
  "PSO",                      pso$par[1],                pso$par[2],               pso$value
) |>
  mutate(across(
    .cols = where(is.numeric),
    .fns  = ~num(.x, digits = 5)
  ))
type x y fit
Gradient (0, 0) 3.18516 1.73879 -0.90612
Gradient (0, 0) s krokem 3.18666 2.93928 -1.51597
Gradient (2.5, 2.5) 3.18516 3.12980 -1.80835
Evoluční algoritmus 3.18516 3.12980 1.80835
PSO 3.18516 3.12980 -1.80835